home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / TOOL_USE / MDOSIO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-01  |  9KB  |  360 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * mdosio - library for interface to DOS v3 file access functions (3-1-89)
  15.  *
  16.  *)
  17.  
  18. {$i prodef.inc}
  19.  
  20. unit MDosIO;
  21.  
  22. interface
  23.  
  24.    uses Dos;
  25.  
  26.    type
  27.       dos_filename = string[64];
  28.       dos_handle   = word;
  29.  
  30.       long_integer = record
  31.          lsw: word;
  32.          msw: word;
  33.       end;
  34.  
  35.       seek_modes = (seek_start {0},
  36.                     seek_cur   {1},
  37.                     seek_end   {2});
  38.  
  39.       open_modes = (open_read  {h40},     {deny_nothing, allow_read}
  40.                     open_write {h41},     {deny_nothing, allow_write}
  41.                     open_update{h42});    {deny_nothing, allow_read+write}
  42.  
  43.       dos_time_functions = (time_get,
  44.                             time_set);
  45.  
  46.    const
  47.       dos_error    = $FFFF; {file handle after an error}
  48.  
  49.    var
  50.       dos_regs:     registers;
  51.       dos_name:     dos_filename;
  52.  
  53.  
  54.    procedure dos_call;
  55.  
  56.    function dos_open(name:      dos_filename;
  57.                      mode:      open_modes):  dos_handle;
  58.  
  59.    function dos_create(name:    dos_filename): dos_handle;
  60.  
  61.    function dos_read( handle:   dos_handle;
  62.                       var       buffer;
  63.                       bytes:    word): word;
  64.  
  65.    procedure dos_write(handle:  dos_handle;
  66.                        var      buffer;
  67.                        bytes:   word);
  68.  
  69.    function dos_write_failed:   boolean;
  70.  
  71.    procedure dos_lseek(handle:  dos_handle;
  72.                        offset:  longint;
  73.                        method:  seek_modes);
  74.  
  75.    procedure dos_rseek(handle:  dos_handle;
  76.                        recnum:  word;
  77.                        recsiz:  word;
  78.                        method:  seek_modes);
  79.  
  80.    function dos_tell: longint;
  81.  
  82.    procedure dos_find_eof(fd:   dos_handle);
  83.  
  84.    procedure dos_close(handle:  dos_handle);
  85.  
  86.    procedure dos_unlink(name:   dos_filename);
  87.  
  88.    procedure dos_file_times(fd:       dos_handle;
  89.                             func:     dos_time_functions;
  90.                             var time: word;
  91.                             var date: word);
  92.  
  93.    function dos_jdate(time,date: word): longint;
  94.  
  95.    function dos_exists(name: dos_filename): boolean;
  96.  
  97.  
  98. implementation
  99.  
  100. (* -------------------------------------------------------- *)
  101. procedure dos_call;
  102. var
  103.    msg:  string;
  104. begin
  105.    msdos(dos_regs);
  106.  
  107.    if (dos_regs.flags and Fcarry) <> 0 then
  108.    begin
  109.       case dos_regs.ax of
  110.          2:   msg := 'file not found';
  111.          3:   msg := 'dir not found';
  112.          4:   msg := 'too many open files';
  113.          5:   msg := 'access denied';
  114.          else str(dos_regs.ax,msg);
  115.       end;
  116. {$I-}
  117.       writeln(' DOS error [',msg,'] on file [',dos_name,'] ');
  118. {$i+}
  119.       dos_regs.ax := dos_error;
  120.    end;
  121. end;
  122.  
  123.  
  124. (* -------------------------------------------------------- *)
  125. procedure prepare_dos_name(name: dos_filename);
  126. begin
  127.    while (name <> '') and (name[length(name)] <= ' ') do
  128.       dec(name[0]);
  129.    if name = '' then
  130.       name := 'Nul';
  131.    dos_name := name;
  132.    dos_name[length(dos_name)+1] := #0;
  133.    dos_regs.ds := seg(dos_name);
  134.    dos_regs.dx := ofs(dos_name)+1;
  135. end;
  136.  
  137.  
  138. (* -------------------------------------------------------- *)
  139. function dos_open(name:    dos_filename;
  140.                   mode:    open_modes):  dos_handle;
  141. var
  142.    try: integer;
  143. const
  144.    retry_count = 3;
  145.  
  146. begin
  147.    for try := 1 to retry_count do
  148.    begin
  149.       dos_regs.ax := $3d40 + ord(mode);
  150.       prepare_dos_name(name);
  151.       msdos(dos_regs);
  152.  
  153.       if (dos_regs.flags and Fcarry) = 0 then
  154.       begin
  155.          dos_open := dos_regs.ax;
  156.          exit;
  157.       end;
  158.    end;
  159.  
  160.    dos_open := dos_error;
  161. end;
  162.  
  163.  
  164. (* -------------------------------------------------------- *)
  165. function dos_create(name:    dos_filename): dos_handle;
  166. begin
  167.    dos_regs.ax := $3c00;
  168.    prepare_dos_name(name);
  169.    dos_regs.cx := 0;   {attrib}
  170.    dos_call;
  171.    dos_create := dos_regs.ax;
  172. end;
  173.  
  174.  
  175. (* -------------------------------------------------------- *)
  176. function dos_read( handle:  dos_handle;
  177.                    var      buffer;
  178.                    bytes:   word): word;
  179. begin
  180.    dos_regs.ax := $3f00;
  181.    dos_regs.bx := handle;
  182.    dos_regs.cx := bytes;
  183.    dos_regs.ds := seg(buffer);
  184.    dos_regs.dx := ofs(buffer);
  185.    dos_call;
  186.    dos_read := dos_regs.ax;
  187. end;
  188.  
  189.  
  190. (* -------------------------------------------------------- *)
  191. procedure dos_write(handle:  dos_handle;
  192.                     var      buffer;
  193.                     bytes:   word);
  194. begin
  195.    dos_regs.ax := $4000;
  196.    dos_regs.bx := handle;
  197.    dos_regs.cx := bytes;
  198.    dos_regs.ds := seg(buffer);
  199.    dos_regs.dx := ofs(buffer);
  200.    dos_call;
  201.    dos_regs.cx := bytes;
  202. end;
  203.  
  204. function dos_write_failed: boolean;
  205. begin
  206.    dos_write_failed := dos_regs.ax <> dos_regs.cx;
  207. end;
  208.  
  209.  
  210. (* -------------------------------------------------------- *)
  211. procedure dos_lseek(handle:  dos_handle;
  212.                     offset:  longint;
  213.                     method:  seek_modes);
  214. var
  215.    pos:  long_integer absolute offset;
  216.  
  217. begin
  218.    dos_regs.ax := $4200 + ord(method);
  219.    dos_regs.bx := handle;
  220.    dos_regs.cx := pos.msw;
  221.    dos_regs.dx := pos.lsw;
  222.    dos_call;
  223. end;
  224.  
  225.  
  226. (* -------------------------------------------------------- *)
  227. procedure dos_rseek(handle:  dos_handle;
  228.                     recnum:  word;
  229.                     recsiz:  word;
  230.                     method:  seek_modes);
  231. var
  232.    offset: longint;
  233.    pos:    long_integer absolute offset;
  234.  
  235. begin
  236.    offset := longint(recnum) * longint(recsiz);
  237.    dos_regs.ax := $4200 + ord(method);
  238.    dos_regs.bx := handle;
  239.    dos_regs.cx := pos.msw;
  240.    dos_regs.dx := pos.lsw;
  241.    dos_call;
  242. end;
  243.  
  244.  
  245. (* -------------------------------------------------------- *)
  246. function dos_tell: longint;
  247.   {call immediately after dos_lseek or dos_rseek}
  248. var
  249.    pos:  long_integer;
  250.    li:   longint absolute pos;
  251. begin
  252.    pos.lsw := dos_regs.ax;
  253.    pos.msw := dos_regs.dx;
  254.    dos_tell := li;
  255. end;
  256.  
  257.  
  258. (* -------------------------------------------------------- *)
  259. procedure dos_find_eof(fd: dos_handle);
  260.    {find end of file, skip backward over ^Z eof markers}
  261. var
  262.    b: char;
  263.    n: word;
  264.    i: word;
  265.    p: longint;
  266.    temp: array[1..128] of char;
  267.  
  268. begin
  269.    dos_lseek(fd,0,seek_end);
  270.    p := dos_tell-1;
  271.    if p < 0 then
  272.       exit;
  273.  
  274.    p := p and $FFFF80;   {round to last 'sector'}
  275.    {search forward for the eof marker}
  276.    dos_lseek(fd,p,seek_start);
  277.    n := dos_read(fd,temp,sizeof(temp));
  278.    i := 1;
  279.  
  280.    while (i <= n) and (temp[i] <> ^Z) do
  281.    begin
  282.       inc(i);
  283.       inc(p);
  284.    end;
  285.  
  286.    {backup to overwrite the eof marker}
  287.    dos_lseek(fd,p,seek_start);
  288. end;
  289.  
  290.  
  291. (* -------------------------------------------------------- *)
  292. procedure dos_close(handle:  dos_handle);
  293. begin
  294.    dos_regs.ax := $3e00;
  295.    dos_regs.bx := handle;
  296.    msdos(dos_regs);  {dos_call;}
  297. end;
  298.  
  299.  
  300. (* -------------------------------------------------------- *)
  301. procedure dos_unlink(name:    dos_filename);
  302.    {delete a file, no error message if file doesn't exist}
  303. begin
  304.    dos_regs.ax := $4100;
  305.    prepare_dos_name(name);
  306.    msdos(dos_regs);
  307. end;
  308.  
  309.  
  310. (* -------------------------------------------------------- *)
  311. procedure dos_file_times(fd:       dos_handle;
  312.                          func:     dos_time_functions;
  313.                          var time: word;
  314.                          var date: word);
  315. begin
  316.    dos_regs.ax := $5700 + ord(func);
  317.    dos_regs.bx := fd;
  318.    dos_regs.cx := time;
  319.    dos_regs.dx := date;
  320.    dos_call;
  321.    time := dos_regs.cx;
  322.    date := dos_regs.dx;
  323. end;
  324.  
  325.  
  326. (* -------------------------------------------------------- *)
  327. function dos_jdate(time,date: word): longint;
  328. begin
  329.  
  330. (***
  331.      write(' d=',date:5,' t=',time:5,' ');
  332.      write('8',   (date shr 9) and 127:1); {year}
  333.      write('/',   (date shr 5) and  15:2); {month}
  334.      write('/',   (date      ) and  31:2); {day}
  335.      write(' ',   (time shr 11) and 31:2); {hour}
  336.      write(':',   (time shr  5) and 63:2); {minute}
  337.      write(':',   (time shl  1) and 63:2); {second}
  338.      writeln(' j=', (longint(date) shl 16) + longint(time));
  339.  ***)
  340.  
  341.    dos_jdate := (longint(date) shl 16) + longint(time);
  342. end;
  343.  
  344.  
  345. (* -------------------------------------------------------- *)
  346. function dos_exists(name: dos_filename): boolean;
  347. var
  348.    DirInfo:     SearchRec;
  349.  
  350. begin
  351.    prepare_dos_name(name);
  352.    FindFirst(dos_name,$21,DirInfo);
  353.    if (DosError <> 0) then
  354.       dos_exists := false
  355.    else
  356.       dos_exists := true;
  357. end;
  358.  
  359. end.
  360.